ReferenceClasses

What do we need?

• A way to represent a state of being
• A way to represent the transitions between states as well as their attributes (time, awesomeness-factor, etc.)
• Algorithms to calculate the the optimal set of state to traverse

Process:

• Assign weights to the transitions
• And calculate what the boundries of the states as a whole are

Directed Acyclic Graphs (aka DAG)

• Nodes (Vertices)
• Directed Edges ( pairs of nodes)
• No Cycles

• No typing - live in the wild west
• No standard - reinventing the wheel one line at a time
• No abstraction - very verbose with a lot of index hunting

• No typing - live in the wild west
• No standard - reinventing the wheel one line at a time
• No abstraction - very verbose with a lot of index hunting

S3 Classes:

n1 <- list(id = 1)

class(n1) <- "node"

print.node <- function(obj){

  cat("Class:",class(obj),
      "\nID:",obj$id)
}
print(n1)

Class: node 
ID: 1

Benefits:

• At least there is some kind of structure
• Class specific functions might be useful

Overall: 5/10

S4 Classes:

node <- setClass("node", slots=list(id="numeric"))

n1 <- node(id = 1)

print.node <- function(obj){

  cat("Class:",class(obj),
      "\nID:",obj@id)
}
print(n1)

Class: node 
ID: 1

Benefits:

• Typing
• Structured way of creating and interacting with object (even though you're using @ instread of $)

Overall 8/10

Reference Classes:

node <- setRefClass("nodeR", fields = list(id = "numeric"), 
                     methods = list(
                       show = function(){
                          cat("Node\nID:",id,"\n")
                       }
                     ))
n1 <- node(id = 1)

print(n1)

Node
ID: 1 

Benefits:

• Unlike S3 and S4 methods belong to class
• Able to have pointer like functionality
• Powerful abstraction layer

Overall 10/10 !

Right way to copy:

n2 <- n1$copy()
n2$id <- 2
n1

Node
ID: 1 

Create some reference classes.

g<-dag()
g$load_from_file('classic_bst')
g$plot()

g$plot_heirarchy()

g$plot_heirarchy(colorRootLeaves = T)

g$plot(colorRootLeaves = T)

g$plot_heirarchy(colorRootLeaves = T, turn = T)

g$close_graph()
g$plot_heirarchy(colorRootLeaves = T, turn = T)

We might be interested in a feature of the graph

• shortest paths
• critical paths
• min/max cut
• or other features

g$shortest_path(g$root_nodes(), g$leaf_nodes())

g$plot_heirarchy(T, T, g$shortest_path(g$root_nodes(), g$leaf_nodes()))

g$plot_heirarchy(T, T, g$critical_path(g$root_nodes(), g$leaf_nodes()))

You're right, that was too quick. What just happened?

• No, just the right amount of kill.
• Don't reinvent the wheel
• Graphs can have multiple metrics/features
• Extracting features consistently for search is troublesome
• Which brings us to the Zebra suit.

g <- dag(vertexCount = 0)

awake <- g$newVertex(description = "Awake")
awake

State
Description: Awake 
ID: 0 

dressedA <- g$newVertex(description = "DressedA")
dressedA

State
Description: DressedA 
ID: 1 

dressedB <- g$newVertex(description = "DressedB")
dressedB

State
Description: DressedB 
ID: 2 

getDressedA <- g$createTransition(from = awake,to = dressedA, weight = 1, description = "Getting pretty")
getDressedA

Edge
Description: Getting pretty 
Weight: 1 
From:
State
Description: Awake 
ID: 0 
To:
State
Description: DressedA 
ID: 1 

getDressedB <- g$createTransition(from = awake,to = dressedB, weight = 0.5, description = "Getting cool")

State:

state <- setRefClass("vertex", fields = list(id = "numeric", description = "character"), 
                     methods = list(
                       show = function(){
                          cat("State\nDescription:",description, "\nID:",id,"\n")
                       }
                     ))

Transition:

transition <- setRefClass("edge", fields = list(from = "vertex", to = "vertex", weight = "numeric", description ="character"),
                          methods = list(
                            show = function(){
                              cat("Edge\nDescription:",description,"\nWeight:",weight, "\nFrom:\n")
                              from$show()
                              cat("To:\n")
                              to$show()
                            })
)

DAG:

adjList <- setRefClass("adjList", fields = list(adjs = "list"),
                       methods = list(
                         addEdge = function(e){
                           if(!("edge" %in% class(e))){
                             stop("Cannot add non edge class to adjacency list")
                           }
                           vName <- paste0("v",e$from$id)
                           adjs[[vName]] <<- c(adjs[[vName]],e$to$id)
                           cat("Edge Added")
                         },
                         show = function(){
                           vNames <- names(adjs)
                           for(vN in vNames){
                            cat("Vertex:",vN,"\n")
                            cat("Adjs:",adjs[[vN]],"\n")
                           }
                         }
                       )
                       )

dag <- setRefClass("dag", fields = list( vertices = "list", edges = "list", adjList = "adjList", vertexCount = "numeric"),
                  methods = list(
                    newVertex = function(description){
                      v <- state(id = vertexCount, description = description )
                      vertexCount <<- vertexCount + 1
                      vertices <<- c(vertices,v)
                      return(v)
                    },
                    createTransition = function(from, to, weight, description){

                      e <- transition(from = from, to = to, weight= weight, description = description)
                      edges <<- c(edges,e)
                      adjList$addEdge(e)

                      return(e)
                    }
                  ))